perm filename NEWBGB[1,LMM] blob
sn#034811 filedate 1973-04-14 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "14-APR-73 03:16:05")
T)
(LISPXTERPRI T))
(LISPXPRINT (QUOTE BGBMATCHVARS)
T)
(RPAQQ BGBMATCHVARS
((FNS APPREV ASSIGN ASSIGNFAIL DISJOINT DOTS DOTSCHECK EQSET
EXAMPLETYPE FILTERASSIGN HYDROGENS INVALID ISIT
LESSLENGTH LIKE NBRSCHECK NEIGHBORS NHSCHECK ONEP
PRUNEASSIGN SUBMATCH SUBMATCH1 SUBSETP TYPE UORDER
RCHECK VALDISTCHECK SUBTYPE SUBDOTS SUBNHS SUBXDOTS
SUBXNHS)
(VARS DARINGLIST MATCHTESTLIST)
(!RECORD SUBCTENTRY)))
(DEFINEQ
(APPREV
[LAMBDA (L1 L2)
(APPEND (REVERSE L1)
L2])
(ASSIGN
[LAMBDA (SUB BIG MLIST)
(PROG (X1 B1 ASGN)
A (COND
((NULL SUB)
(RETURN ASGN)))
(SETQ X1 (CAR SUB))
(SETQ SUB (CDR SUB))
[SETQ B1 (SUBSET BIG (FUNCTION (LAMBDA (U)
(* Makes a preliminary assignment of atoms of SUB to
BIG -
Using the set of tests given as MLIST
(which is a list of function names) -
If the MLIST is NIL then the global variable
MATCHTESTLIST will be used)
(LIKE X1 U MLIST]
(COND
((NULL B1)
(RETURN NIL)))
(SETQ ASGN (CONS (CONS X1 B1)
ASGN))
(GO A])
(ASSIGNFAIL
[LAMBDA (ASGN)
(ONEP (LENGTH (CAR ASGN])
(DISJOINT
[LAMBDA (L1 L2)
(FOR NEW X IN L1 WHEN (NOT (MEMBER X L2))
LIST X])
(DOTS
[LAMBDA (A)
(* Gives the number of DOTS
(OR EQUIVALENT THEREOF) of A node of the BIGGRAPH)
(COND
(DOTNOTATION (ERROR "NOT IMPLEMENTED YET"))
(T (FOR A ON A WHEN (AND (NOT (EQ (CAR A)
(QUOTE FV)))
(MEMBER (CAR A)
(CDR A)))
PLUS 1])
(DOTSCHECK
[LAMBDA (SUB BIG) (* This FN can be made a
member of MATCHTESTLIST)
(IF (SUBXDOTS SUB)
THEN (EQUAL (DOTS BIG)
(SUBXDOTS SUB))
ELSE (LEQ (SUBDOTS SUB)
(DOTS BIG])
(EQSET
[LAMBDA (L1 L2)
(AND (SUBSETP L1 L2)
(SUBSETP L2 L1])
(EXAMPLETYPE
[LAMBDA (SUBTYP BIGTYP)
(* Checks for equivalence (or satisfaction of
nominal requirements-) for atom types of bigatom and
subatom)
(SETQ BIGTYP (TYPE BIGTYP))
(SETQ SUBTYP (SUBTYPE SUBTYP))
(COND
((ATOM SUBTYP)
(EQ BIGTYP SUBTYP))
(T (MEMBER BIGTYP SUBTYP])
(FILTERASSIGN
[LAMBDA (SUB BIG KNOWN)
(* Takes off the assignment list those not
compatible in the light of matchings already made)
(PROG (KN S1 VAL NSUB)
(SETQ KN KNOWN)
A (COND
((OR (ATOM KN)
(ATOM SUB))
(GO C)))
(SETQ S1 (CAR SUB))
(SETQ SUB (CDR SUB))
(SETQ VAL (SASSOC (SUBNODE S1)
KN NIL))
(COND
(VAL (GO B)))
(SETQ NSUB (CONS S1 NSUB))
(GO A)
B (COND
((NOT (LIKE S1 (CDR VAL)))
(RETURN NIL)))
(SETQ KN (REMOVE KN VAL))
(GO A)
C (SETQ NSUB (APPREV SUB NSUB))
(COND
((ATOM NSUB)
(RETURN T)))
[SETQ BIG (DISJOINT BIG (MAPCAR KNOWN (FUNCTION CDR]
(COND
((LESSP (LENGTH BIG)
(LENGTH NSUB))
(RETURN NIL)))
(RETURN (ASSIGN NSUB BIG])
(HYDROGENS
[LAMBDA (BIGATOM)
(* Needs redefinition WHEN a different or
alternative manner of representing HYDROGENS is
devised)
(FOR NEW N IN (NBRS BIGATOM) WHEN (EQ N (QUOTE FV))
PLUS 1])
(INVALID
[LAMBDA (PR OLDMAP)
(* Believe that this function is the one that
assures the topological MAPPING between the SUBGRAPH
and BIGGRAPH by doing the detailed atom by atom
CHECK of the preservation of adjacency
(OR NEIGHBORHOOD) requirement)
(PROG (B1 OLDB S1 NS NB X1)
(COND
((NULL OLDMAP)
(RETURN NIL)))
(SETQ B1 (CDR PR))
(COND
([MEMBER B1 (SETQ OLDB (MAPCAR OLDMAP
(FUNCTION CDR]
(RETURN T)))
(SETQ S1 (CAR PR))
(SETQ NS (SUBNBRS S1))
(SETQ NB (NEIGHBORS B1))
(SETQ X1 NB)
[SETQ NB (FOR NEW X
IN X1 XLIST (FOR NEW Z IN OLDMAP
WHEN (EQUAL (CDR Z)
X)
DO (RETURN Z]
(SETQ X1 NS)
[SETQ NS (FOR NEW X
IN X1 XLIST (FOR NEW Z IN OLDMAP
WHEN (EQUAL (CAR Z)
X)
DO (RETURN Z]
(COND
((EQUAL (CLCREATE NB)
(CLCREATE NS))
(RETURN NIL)))
(RETURN T])
(ISIT
[LAMBDA (SUBGRAPH BIGGRAPH)
(* The toplevel function -- has now the flexibility
to supply the testlist to be used in making the
assignments)
(* (only one match will be tried -- and true or
false determined from that))
(SUBMATCH SUBGRAPH BIGGRAPH 1])
(LESSLENGTH
[LAMBDA (L1 L2)
(NOT (GREATERP (LENGTH L1)
(LENGTH L2])
(LIKE
[LAMBDA (SUBATOM BIGATOM MLIST)
(FOR NEW TEST IN (OR MLIST MATCHTESTLIST)
AND (APPLY* TEST SUBATOM BIGATOM])
(NBRSCHECK
[LAMBDA (SUB BIG)
(LEQ (LENGTH (SUBNBRS SUBATOM))
(LENGTH (NEIGHBORS BIGATOM])
(NEIGHBORS
[LAMBDA (A)
(MAPCAR (NBRS A)
(FUNCTION (LAMBDA (X)
(COND
((NOT (EQ (QUOTE FV)
X))
(FINDCTE X STRUCTURE])
(NHSCHECK
[LAMBDA (SUB BIG)
(IF (SUBXNHS SUB)
THEN (EQUAL (HYDROGENS BIG)
(SUBXNHS SUB))
ELSE (LEQ (SUBNHS SUB)
(HYDROGENS BIG])
(ONEP
[LAMBDA (N)
(EQP N 1])
(PRUNEASSIGN
[LAMBDA (SUB BIGS OLDMAP BG) (* Will have to ask
buchanan or look up his
documentation)
(PROG (X1 NMAP NB NNB)
(SETQ X1 (SUBNBRS SUB))
[SETQ NMAP (SUBSET OLDMAP (FUNCTION (LAMBDA (U)
(MEMBER (CAR U)
X1]
(COND
((NULL NMAP)
(RETURN BIGS)))
(SETQ NB (INTERSECTION NB NB))
(SETQ NB (MAPCAR NMAP (FUNCTION CDR)))
(SETQ NNB (MAPCONC NB (FUNCTION NEIGHBORS)))
(RETURN (INTERSECTION BIGS NNB])
(SUBMATCH
[LAMBDA (SUBGRAPH STRUC M)
(PROG (ASSGN)
(GSET (QUOTE MATCHNUM)
M)
(GSET (QUOTE STRUCTURE)
(COND
((STRUCTURE? STRUC)
(SETQ STRUC (CTABLE STRUC)))
(T STRUC)))
(SETQ MAPPINGLIST NIL)
(SETQ ASSGN (UORDER (FILTERASSIGN SUBGRAPH STRUC MAPPING)))
[COND
((NULL ASSGN)
(RETURN NIL))
((ATOM ASSGN)
(RETURN (SETQ MAPPINGLIST (LIST MAPPING]
(SUBMATCH1 (CAR ASSGN)
MAPPING
(CDR ASSGN)
STRUC)
(RETURN MAPPINGLIST])
(SUBMATCH1
[LAMBDA (NEWASSUME KNOWN POSSMAP BG)
(PROG (NEWA1 ANS)
(SETQ NEWASSUME (CONS (CAR NEWASSUME)
(PRUNEASSIGN (CAR NEWASSUME)
(CDR NEWASSUME)
KNOWN BG)))
A (COND
((NULL (CDR NEWASSUME))
(RETURN NIL)))
(SETQ NEWA1 (CONS (CAR NEWASSUME)
(CADR NEWASSUME)))
(SETQ NEWASSUME (CONS (CAR NEWASSUME)
(CDDR NEWASSUME)))
(COND
((INVALID NEWA1 KNOWN)
(GO A)))
(COND
((NULL POSSMAP)
(GO B)))
(SETQ ANS (SUBMATCH1 (CAR POSSMAP)
(CONS (CONS (SUBNODE (CAR NEWA1))
(CDR NEWA1))
KNOWN)
(CDR POSSMAP)
BG))
(COND
((NULL ANS)
(GO A)))
(RETURN ANS)
B (SETQ MATCHNUM (SUB1 MATCHNUM))
(SETQ MAPPINGLIST (CONS (CONS (CONS (SUBNODE (CAR NEWA1))
(CDR NEWA1))
KNOWN)
MAPPINGLIST))
(COND
((ZEROP MATCHNUM)
(RETURN MAPPINGLIST)))
(GO A])
(SUBSETP
[LAMBDA (L1 L2)
(FOR NEW X IN L1 AND (MEMBER X L2])
(TYPE
[LAMBDA (A)
(ATOMTYPE (MARKERS A])
(UORDER
[LAMBDA (ASGN)
(* Sorts the atoms of SUBGRAPH according to
increasing sets of possible MAPPING BIGGRAPH atoms--
believe this helps in finding non-matches quicker)
(PROG (ANS)
(SETQ ANS (SORT ASGN (FUNCTION LESSLENGTH)))
(COND
((ASSIGNFAIL ANS)
(RETURN NIL)))
(RETURN ANS])
(RCHECK
[LAMBDA (A B)
(PROG NIL
(FOR NEW I :=(SON TILL)
AS NEW L IS (NTH LL I)
WHEN (NOT (MEMBER I REDUNDANTS))
LIST
(FOR NEW X
ON (NTH XX (ADD1 I))
AS NEW J :=((ADD1 I)
17)
LIST
(TERPRI)
(TERPRI)
(PRINT I)
(PRINT J)
(TIME [COND
((ISIT (CAR X)
(CAR L))
(PRINT (QUOTE
********************SAME))
(SETQ REDUNDANTS (CONS J REDUNDANTS)))
(T (PRINT (QUOTE DO-NOT-MATCH]
1 0])
(VALDISTCHECK
[LAMBDA (SUB BIG)
(EQUAL (CLCREATE (FOR NEW X IN (CLCREATE (NBRS BIG))
LIST
(CDR X)))
(CLCREATE (FOR NEW X IN (CLCREATE (SUBNBRS SUB))
LIST
(CDR X])
(SUBTYPE
[NLAMBDA RECORDFIELDVAR
(SETQ RECORDFIELDVAR (REMOVE (QUOTE OF)
RECORDFIELDVAR))
(EVAL (SUBST (COND
((NULL (CDR RECORDFIELDVAR))
(CAR RECORDFIELDVAR))
(T RECORDFIELDVAR))
(QUOTE X)
(QUOTE (CAR (CDR X])
(SUBDOTS
[NLAMBDA RECORDFIELDVAR
(SETQ RECORDFIELDVAR (REMOVE (QUOTE OF)
RECORDFIELDVAR))
(EVAL (SUBST (COND
((NULL (CDR RECORDFIELDVAR))
(CAR RECORDFIELDVAR))
(T RECORDFIELDVAR))
(QUOTE X)
(QUOTE (CAR (CDR (CDR (CDR X])
(SUBNHS
[NLAMBDA RECORDFIELDVAR
(SETQ RECORDFIELDVAR (REMOVE (QUOTE OF)
RECORDFIELDVAR))
(EVAL (SUBST (COND
((NULL (CDR RECORDFIELDVAR))
(CAR RECORDFIELDVAR))
(T RECORDFIELDVAR))
(QUOTE X)
(QUOTE (CAR (CDR (CDR (CDR (CDR X])
(SUBXDOTS
[NLAMBDA RECORDFIELDVAR
(SETQ RECORDFIELDVAR (REMOVE (QUOTE OF)
RECORDFIELDVAR))
(EVAL
(SUBST (COND
((NULL (CDR RECORDFIELDVAR))
(CAR RECORDFIELDVAR))
(T RECORDFIELDVAR))
(QUOTE X)
(QUOTE (CAR (CDR (CDR (CDR (CDR (CDR X])
(SUBXNHS
[NLAMBDA RECORDFIELDVAR
(SETQ RECORDFIELDVAR (REMOVE (QUOTE OF)
RECORDFIELDVAR))
(EVAL
(SUBST
(COND
((NULL (CDR RECORDFIELDVAR))
(CAR RECORDFIELDVAR))
(T RECORDFIELDVAR))
(QUOTE X)
(QUOTE (CAR (CDR (CDR (CDR (CDR (CDR (CDR X])
)
[RPAQQ DARINGLIST ((STRUCTURE ((CTENTRY 1 (N)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (N)
1 5)
(CTENTRY 5 (C)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2)))
(STRUCTURE ((CTENTRY 1 (C)
6 2 2)
(CTENTRY 2 (N)
3 1 1)
(CTENTRY 6 (N)
1 5)
(CTENTRY 5 (C)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2)))
(STRUCTURE ((CTENTRY 1 (N)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (C)
1 5)
(CTENTRY 5 (N)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2)))
(STRUCTURE ((CTENTRY 1 (C)
6 2 2)
(CTENTRY 2 (N)
3 1 1)
(CTENTRY 6 (C)
1 5)
(CTENTRY 5 (N)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2]
(RPAQQ MATCHTESTLIST (VALDISTCHECK))
(DEFLIST(QUOTE(
(SUBCTENTRY (SUBNODE SUBMARKERS . SUBNBRS))
))(QUOTE !RECORD))
(!RECORD (QUOTE SUBCTENTRY))
STOP